home *** CD-ROM | disk | FTP | other *** search
/ Freelog 55 / Freelog055.iso / Bas / Educatif / A laferme / Unit1.pas < prev    next >
Pascal/Delphi Source File  |  2003-05-03  |  10KB  |  345 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, Grids, Menus, StdCtrls, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     MainMenu1: TMainMenu;
  13.     Rgledujeu1: TMenuItem;
  14.     Recommencer1: TMenuItem;
  15.     Quitter1: TMenuItem;
  16.     StaticText1: TStaticText;
  17.     StaticText2: TStaticText;
  18.     StaticText3: TStaticText;
  19.     RadioGroup1: TRadioGroup;
  20.     RadioGroup2: TRadioGroup;
  21.     Joueur1: TEdit;
  22.     Joueur2: TEdit;
  23.     Image1: TImage;
  24.     Image2: TImage;
  25.     Image3: TImage;
  26.     Image4: TImage;
  27.     Image5: TImage;
  28.     Image6: TImage;
  29.     Image7: TImage;
  30.     Image8: TImage;
  31.     Image9: TImage;
  32.     Image10: TImage;
  33.     Image11: TImage;
  34.     Image12: TImage;
  35.     Image13: TImage;
  36.     Image14: TImage;
  37.     Image15: TImage;
  38.     Image16: TImage;
  39.     Image17: TImage;
  40.     Image18: TImage;
  41.     Image19: TImage;
  42.     Image20: TImage;
  43.     Image21: TImage;
  44.     Image22: TImage;
  45.     Image23: TImage;
  46.     Image24: TImage;
  47.     Image25: TImage;
  48.     Image26: TImage;
  49.     Image27: TImage;
  50.     Image28: TImage;
  51.     Image29: TImage;
  52.     Image30: TImage;
  53.     Image31: TImage;
  54.     Image32: TImage;
  55.     Image33: TImage;
  56.     Image34: TImage;
  57.     Image35: TImage;
  58.     Image36: TImage;
  59.     Image37: TImage;
  60.     Image38: TImage;
  61.     Image39: TImage;
  62.     Image40: TImage;
  63.     Image41: TImage;
  64.     Image42: TImage;
  65.     bouton: TBitBtn;
  66.     Timer1: TTimer;
  67.     StaticText4: TStaticText;
  68.     StaticText5: TStaticText;
  69.     StaticText6: TStaticText;
  70.     Bevel1: TBevel;
  71.     procedure debut;
  72.     procedure FormActivate(Sender: TObject);
  73.     procedure RadioGroup2Click(Sender: TObject);
  74.     procedure RadioGroup1Click(Sender: TObject);
  75.     procedure fin_jeu;
  76.     procedure boutonClick(Sender: TObject);
  77.     procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  78.           Shift: TShiftState; X, Y: Integer);
  79.     procedure Timer1Timer(Sender: TObject);
  80.     procedure Quitter1Click(Sender: TObject);
  81.     procedure Recommencer1Click(Sender: TObject);
  82.     procedure Rgledujeu1Click(Sender: TObject);
  83.  
  84.     { DΘclarations privΘes }
  85.   public
  86.     { DΘclarations publiques }
  87.   end;
  88.  
  89. var
  90.   Form1                      : TForm1;
  91.   cdeb,cfin,ldeb,lfin,nbrej  :integer;
  92.   xdeb,xfin,ydeb,yfin        :integer;
  93.   ncp,nim,njeu,ntemp,nj      :integer;
  94.   fin                        :string;
  95.   score,nessai,cj,lj         :array[0..2] of integer;
  96.   cell                       :array[0..5] of array[0..6] of integer;
  97.   nomj                       :array[0..2] of string;
  98.   im                         :array[0..5] of array[0..6] of Timage;
  99.   fond                       :array[0..1] of Timage;
  100.   anim                       :array[0..9]of Timage;
  101. implementation
  102.  
  103. uses Unit2;
  104.  
  105. {$R *.DFM}
  106.  
  107. procedure Tform1.debut;
  108. {initialisation des composants visuels}
  109. var   n,p,q                            :integer;
  110. begin
  111. timer1.enabled:=false;Rgledujeu1.enabled:=true;
  112. panel1.color:=clnavy;fin:='non';
  113. radiogroup1.itemIndex:=-1;radiogroup1.enabled:=false;
  114. radiogroup2.itemIndex:=-1;radiogroup2.enabled:=true;
  115. joueur1.enabled:=false;joueur2.enabled:=false;
  116. statictext1.caption:='Joueur :';statictext2.caption:='Score :';
  117. statictext3.caption:='Essais numΘro :';statictext6.visible:=false;
  118. statictext4.visible:=false;statictext5.visible:=false;
  119. bouton.caption:='   Jeu!';bouton.enabled:=false;
  120. for n:=1 to 5 do
  121.  begin
  122.  for p:=1 to 6 do
  123.    begin
  124.    im[n][p].enabled:=true;im[n][p].visible:=true;
  125.    q:=(6*(n-1)+p) mod 10;
  126.    im[n][p].picture:=anim[q].picture;cell[n][p]:=0;
  127.    end;
  128.  end;
  129. panel1.enabled:=false;
  130. end;
  131.  
  132. procedure TForm1.FormActivate(Sender: TObject);
  133. {remplir le tableau d'images}
  134. begin
  135. im[1][1]:=image1;im[1][2]:=image2;im[1][3]:=image3;
  136. im[1][4]:=image4;im[1][5]:=image5;im[1][6]:=image6;
  137. im[2][1]:=image7;im[2][2]:=image8;im[2][3]:=image9;
  138. im[2][4]:=image10;im[2][5]:=image11;im[2][6]:=image12;
  139. im[3][1]:=image13;im[3][2]:=image14;im[3][3]:=image15;
  140. im[3][4]:=image16;im[3][5]:=image17;im[3][6]:=image18;
  141. im[4][1]:=image19;im[4][2]:=image20;im[4][3]:=image21;
  142. im[4][4]:=image22;im[4][5]:=image23;im[4][6]:=image24;
  143. im[5][1]:=image25;im[5][2]:=image26;im[5][3]:=image27;
  144. im[5][4]:=image28;im[5][5]:=image29;im[5][6]:=image30;
  145. fond[0]:=image31;fond[1]:=image32;anim[0]:=image33;
  146. anim[1]:=image34;anim[2]:=image35;anim[3]:=image36;
  147. anim[4]:=image37;anim[5]:=image38;anim[6]:=image39;
  148. anim[7]:=image40;anim[8]:=image41;anim[9]:=image42;
  149. debut;
  150. end;
  151.  
  152. procedure TForm1.RadioGroup2Click(Sender: TObject);
  153. {pour retourner une image, on clique sur le panel;il faut donc dΘfinir
  154. les images qui correspondent aux coordonnΘes du panel. Ensuite placer les
  155. dos des cartes en fonction du choix de jeu , donner des valeurs au
  156. tableau cell qui contient les numΘros d'images et mΘlanger au hasard
  157. ces numΘros donc mΘlanger les images}
  158. var n,n1,n2,p,p1,p2,ct,ctr            :integer;
  159. begin
  160. randomize;form2.visible:=false;Rgledujeu1.enabled:=false;
  161. case radiogroup2.itemIndex of
  162.      0:begin cdeb:=2;cfin:=5;ldeb:=2;lfin:=4;ncp:=2;nim:=6;
  163.              xdeb:=85;xfin:=430;ydeb:=85;yfin:=345;end;
  164.      1:begin cdeb:=2;cfin:=5;ldeb:=1;lfin:=4;ncp:=2;nim:=8;
  165.              xdeb:=85;xfin:=430;ydeb:=5;yfin:=345;end;
  166.      2:begin cdeb:=2;cfin:=5;ldeb:=1;lfin:=5;ncp:=2;nim:=10;
  167.              xdeb:=85;xfin:=430;ydeb:=5;yfin:=425;end;
  168.      3:begin cdeb:=1;cfin:=6;ldeb:=1;lfin:=4;ncp:=3;nim:=8;
  169.              xdeb:=5;xfin:=510;ydeb:=5;yfin:=345;end;
  170.      4:begin cdeb:=1;cfin:=6;ldeb:=1;lfin:=5;ncp:=3;nim:=10;
  171.              xdeb:=5;xfin:=510;ydeb:=5;yfin:=425;end;
  172. end;
  173. for n:=1 to 5 do
  174.   begin
  175.   for p:=1 to 6 do
  176.     begin
  177.     if (n<ldeb)or (n>lfin)or(p<cdeb)or(p>cfin) then
  178.     im[n][p].picture:=fond[0].picture          else
  179.     im[n][p].picture:=fond[1].picture;
  180.     im[n][p].enabled:=false;
  181.     end;
  182.   end;
  183. ct:=0;
  184. for n:=ldeb to lfin do
  185.    begin
  186.    for p:=cdeb to cfin do
  187.      begin
  188.      ct:=ct+1;ctr:=ct mod nim;
  189.      cell[n][p]:=ctr;
  190.      end;
  191.    end;
  192. for n:=1 to 2000 do
  193.   begin
  194.   n1:=random(lfin+1-ldeb)+ldeb;p1:=random(cfin+1-cdeb)+cdeb;
  195.   cell[0][0]:=cell[n1][p1];
  196.   n2:=random(lfin+1-ldeb)+ldeb;p2:=random(cfin+1-cdeb)+cdeb;
  197.   cell[n1][p1]:=cell[n2][p2];cell[n2][p2]:=cell[0][0];
  198.   end;
  199. radiogroup2.enabled:=false;
  200. radiogroup1.enabled:=true;
  201. end;
  202.  
  203. procedure TForm1.RadioGroup1Click(Sender: TObject);
  204. {choix du nombre de joueurs et de chaque nom}
  205. begin
  206. case radiogroup1.itemIndex of
  207.      0:begin nbrej:=1;joueur1.enabled:=true;end;
  208.      1:begin nbrej:=2;joueur1.enabled:=true;joueur2.enabled:=true;end;
  209. end;
  210. radiogroup1.enabled:=false;bouton.enabled:=true;
  211. end;
  212.  
  213. procedure Tform1.fin_jeu;
  214. var       n,p            :integer;
  215. begin
  216. for n:=1 to 5 do
  217.     begin
  218.     for p:=1 to 6 do im[n][p].enabled:=true;
  219.     end;
  220. statictext6.visible:=true;
  221. Statictext4.caption:=nomj[1]+' : '+intTostr(score[1]);
  222. statictext4.visible:=true;
  223. if nbrej=2 then
  224.   begin
  225.   Statictext5.caption:=nomj[2]+' : '+intTostr(score[2]);
  226.   statictext5.visible:=true;
  227.   end;
  228. end;
  229.  
  230. procedure TForm1.boutonClick(Sender: TObject);
  231. {lancer le jeu et permettre de voir la solution}
  232. var       n,p,num             :integer;
  233. begin
  234. if bouton.caption='   Jeu!' then
  235.   begin
  236.   nomj[1]:=joueur1.text;
  237.   if nbrej>1 then nomj[2]:=joueur2.text;
  238.   statictext1.caption:='Joueur : '+nomj[1];
  239.   nessai[1]:=1;nessai[2]:=1;score[1]:=0;score[2]:=0;
  240.   statictext2.caption:='Score: '+intTostr(score[1]);
  241.   statictext3.caption:='Essai numΘro: '+intTostr(nessai[1]);
  242.   bouton.caption:='Solution';panel1.enabled:=true;njeu:=0;nj:=1;
  243.   joueur1.enabled:=false;joueur2.enabled:=false;
  244.   end
  245.   else
  246.   begin
  247.   for n:=ldeb to lfin do
  248.    begin
  249.    for p:=cdeb to cfin do
  250.      begin
  251.      num:=cell[n][p];im[n][p].picture:=anim[num].picture;
  252.      im[n][p].visible:=true;im[n][p].enabled:=true;
  253.      end;
  254.    end;
  255.   fin_jeu;
  256.   end;
  257. end;
  258.  
  259.  
  260. procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  261.   Shift: TShiftState; X, Y: Integer);
  262. {retourner les 2 ou 3 images suivant le type de jeu choisi}
  263. var n,p,c,cc,l,ll,num             :integer;
  264. begin
  265.  if (x>xdeb)and(x<xfin)and(y>ydeb)and(y<yfin) then
  266.     begin
  267.     c:=(x div 85);l:=(y div 85);
  268.     if (x-c*85>5) and (y-l*85>5) then
  269.     begin
  270.     l:=l+1;c:=c+1;lj[njeu]:=l;cj[njeu]:=c;
  271.     num:=cell[l][c];im[l][c].picture:=anim[num].picture;
  272.     im[l][c].enabled:=true;im[l][c].visible:=true;
  273.     njeu:=njeu+1;
  274.     end;
  275.     end;
  276. ntemp:=0;
  277. if njeu=ncp then
  278.   begin
  279.   panel1.enabled:=false;timer1.enabled:=true;
  280.   end;
  281. end;
  282.  
  283. procedure TForm1.Timer1Timer(Sender: TObject);
  284. {gestion des images retournΘes: si ce sont les mΩmes :compter des points ,
  285. sinon :retourner les cartes en laissant un peu de temps pour les voir }
  286. var l,c,n,p,q                   :integer;
  287.     gagn                        :string;
  288. begin
  289. timer1.interval:=1000;
  290. ntemp:=ntemp+1;gagn:='non';
  291. if ntemp=3 then
  292.   begin
  293.   if ncp=2 then
  294.    begin
  295.    n:=cell[lj[0]][cj[0]];p:=cell[lj[1]][cj[1]];
  296.    if n=p then
  297.       begin
  298.       if n=0 then score[nj]:=score[nj]+1 else score[nj]:=score[nj]+2;
  299.       gagn:='oui';statictext2.caption:='Score: '+intTostr(score[nj]);
  300.       if score[1]+score[2]=2*nim-1 then fin_jeu;
  301.       end;
  302.    end;
  303.   if ncp=3 then
  304.    begin
  305.    n:=cell[lj[0]][cj[0]];p:=cell[lj[1]][cj[1]];q:=cell[lj[2]][cj[2]];
  306.    if (n=p) and (n=q) and (p=q) then
  307.       begin
  308.       if n=0 then score[nj]:=score[nj]+2 else score[nj]:=score[nj]+3;
  309.       gagn:='oui';statictext2.caption:='Score: '+intTostr(score[nj]);
  310.       if score[1]+score[2]=3*nim-1 then fin_jeu;
  311.       end;
  312.    end;
  313.   if gagn='non' then
  314.    begin
  315.    for n:=0 to ncp-1 do
  316.        begin
  317.        l:=lj[n];c:=cj[n];im[l][c].picture:=fond[1].picture;
  318.        im[l][c].enabled:=false;
  319.        end;
  320.    if nj=1 then nessai[1]:=nessai[1]+1 else nessai[2]:=nessai[2]+1;
  321.    if (nbrej=2)and (nj=1) then nj:=2 else nj:=1;
  322.    statictext1.caption:='Joueur : '+nomj[nj];
  323.    statictext2.caption:='Score: '+intTostr(score[nj]);
  324.    statictext3.caption:='Essai numΘro: '+intTostr(nessai[nj]);
  325.    end;
  326. timer1.enabled:=false;njeu:=0;panel1.enabled:=true;
  327. end;
  328. end;
  329.  
  330. procedure TForm1.Quitter1Click(Sender: TObject);
  331. begin
  332. form1.close;
  333. end;
  334.  
  335. procedure TForm1.Recommencer1Click(Sender: TObject);
  336. begin
  337. debut;
  338. end;
  339. procedure TForm1.Rgledujeu1Click(Sender: TObject);
  340. begin
  341. form2.visible:=true;
  342. end;
  343.  
  344. end.
  345.